home *** CD-ROM | disk | FTP | other *** search
/ MacHack 1994 / MacHack 1994.toast / MacHack™94 / Talks & Papers / Timothy Knox / yerk 3.66 / System source / objInit < prev    next >
Text File  |  1994-06-24  |  2KB  |  65 lines
  1. \ objInit words for Yerk
  2. \  1/07/86  cdn Split from Window
  3. \  8/06/86  cdn Eliminated actFW; never liked it anyway
  4. \ 10/25/91    rfl    moved screenbits to window
  5. \                added setscroll to sysinit, and grayrgn
  6. \  6/08/93    rfl    split sysinit up to two words..eventInit added for compile needs
  7. \  2/08/94    rfl    changed purge in eventInit to purge!, to force modules marked
  8. \                  as locked to be purged at startup
  9.  
  10. \ ( -- addr len )  leave name of the startup document as a string
  11. : myDoc  finfo 12 + count ;
  12.  
  13. \ set appropriate state when fWind is activated
  14. \ : actFW   Decimal  initfont ;
  15.  
  16. : eventInit
  17.     $ c1ef set: fEvent        \ set for all events except autokey
  18.     <[ 4 ]> 'cfas    null-evt    mouse-evt    null-evt    key-evt
  19.     <[ 4 ]> 'cfas    null-evt    key-evt        upd-evt        disk-evt
  20.     <[ 4 ]> 'cfas    actv-evt    null-evt    null-evt    null-evt
  21.     <[ 4 ]> 'cfas    null-evt    null-evt    null-evt    OS-Evt
  22.     <[ 4 ]> 'cfas    null-evt    null-evt    null-evt    null-evt
  23.     <[ 3 ]> 'cfas    null-evt    null-evt    HL-Evt
  24.     put: fEvent
  25.     purge! rekey  +curs ;
  26.  
  27. \ Define system startup word that initializes all nucleus
  28. \ objects - fFcb, fEvent, fpRect, fWind
  29. : sysInit
  30.     filinit
  31.     'c key ' abort 16 + !    \ setup event driven key
  32. \    ' File 'c fFcb !        \ establish nucleus based objects - filinit does this
  33.     ' Event 'c fEvent !
  34.     ' Rect 'c fpRect !
  35.     ' Window 'c fWind !
  36.     <[ 4 ]> 'cfas null null cls null actions: fWind
  37.     myDoc title: fWind
  38.     grayRgn true setGrow: fWind
  39.     eventInit ;
  40.  
  41.  
  42. : clean2  alive: fWind IF set: fWind THEN  initfont clean1 upCase ;
  43.  
  44. : Demit sp@ 3+ 1  write: fFcb drop (emit) ;
  45. : Dtype 2dup      write: fFcb drop (type) ;
  46. : Dcr 13 sp@ 3+ 1 write: fFcb 2drop (cr) ;
  47.  
  48. : ErrLog
  49.     'c Demit -> emitvec
  50.     'c Dtype -> typevec
  51.     'c Dcr   -> crvec
  52.     " ErrLog" name: fFcb
  53.     create: fFcb 0=
  54.     IF    .s clean2
  55.         txType saveSig set: fFcb
  56.         close: fFcb drop
  57.     THEN
  58.     0 -> emitvec
  59.     0 -> typevec
  60.     0 -> crvec
  61. ;
  62.  
  63. 'c sysInit -> objInit
  64. 'c clean2 -> abortvec
  65.